home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / music / c2snd201.zip / CONV2SND.PAS < prev    next >
Pascal/Delphi Source File  |  1994-06-20  |  37KB  |  947 lines
  1. (* Convert to Deskmate Sound, version 2.00      PUBLIC DOMAIN
  2.    Kenneth Udut
  3.    January 14 - 27, 1993
  4.  
  5.    [Modified with the author's permission by Jeffrey L. Hayes, June 14-22, 
  6.    1994.  The code has been beautified and minor modifications done to make 
  7.    it work on Turbo Pascal version 5, which is what I have - Ken has TP6.  
  8.    The filesize bug in version 1.98 of this program has been corrected.  
  9.    This version also allows the user to specify the output filename.  The 
  10.    default is now to use the input filename and attach an .snd extension.  
  11.    This version adds support for Windows .wav files. - J.L. Hayes]
  12.  
  13.    PURPOSE:  This program converts any 8-bit PCM digitized sound into a
  14.    DeskMate Sound file.  It will allow you to use Deskmate's SOUND program
  15.    to edit these files.
  16.  
  17.    My thanks to Christopher Taveres for his program SOUNDOFF, written for
  18.    the Tandy 1000 SL/TL machines to play digitized sounds.  I do hope he
  19.    doesn't mind me borrowing his DeskMate .SND file structure information,
  20.    but I am new at this file distribution thing.
  21.  
  22. ----------------------------------------
  23. DeskMate .SND file structure thanks to:
  24. /* Sound Off!
  25. /* Written by Christopher Taveres 
  26. /* Copyright (c) January 1992
  27. /* Falsoft, Inc.
  28. /* PCM
  29. ----------------------------------------
  30.  
  31.    This program is 100% public domain.  Use it as you will, play with the
  32.    source code, use the source code, and even ask money for your revised
  33.    versions of it!
  34.  
  35.    Just give me a BIG THANKS and, if you don't wish to FREELY distribute
  36.    YOUR source code, -please- make it available for others for a SMALL fee.
  37.  
  38.    Thanks!                            --Kenneth Udut, age 20, 14-JAN-1993
  39.  
  40.    [I second the above. - J.L. Hayes]
  41.  
  42. P.S. - This is Ken on 24-JAN-1993.  Creating a header in TP wasn't the answer,
  43.        so I'm going to attempt to just write the bytes for the header directly.
  44.        Wish me Luck!
  45.  
  46. P.P.S. - Ken again, on the day before his birthday.  It's 27-JAN-1993, and
  47.          I *should* be going to work.  I've decided to release this program
  48.          *NOW*, in its current form.
  49.  
  50.          Needed improvements [According to Ken]:
  51.  
  52.             * DeskMate Interface (okay - wishful thinking, but if I can
  53.               find someone with the SDK, I might ask them to do me a BIG
  54.               favor!!!
  55.  
  56.             * Ability to cut off the old header, if one, before adding
  57.               on the new header.  [Provided for .wav files. - JLH]
  58.  
  59.             * Ability to switch back and forth between DIFFERENT sound
  60.               file types, including DeskMate's, WAV files, etc.
  61.  
  62.             * Ability to decode Instrument files into their separate parts.  
  63.               [Snd2wav, included with this version, can do so. - JLH]
  64.  
  65.   If you like what you see, or don't like it, or think it needs BIG help,
  66.   give me a call at (908) 241-6246, or write me a note at:
  67.  
  68.   Kenneth Udut 170 East Clay Avenue, Roselle Park, NJ USA 07204-2050
  69.   Internet: kudut@ritz.mordor.com
  70.   PC-Link/America Online: K Udut
  71.   CompuServe: INTERNET> kudut@ritz.mordor.com
  72.   Delphi: IN%"kudut@ritz.mordor.com"
  73.  
  74.   If you're in New Jersey, and want to stop by my 'workshop', please do!
  75.   I'll have a pot of tea or coffee waiting for you, and we can sit down
  76.   and chat!  (Just give me a call first or leave me a note!  Thanks! :D )
  77.  
  78.                       --Ken, on January 27, 1993, day before 21st birthday!
  79.  
  80.   [I, not Ken, am responsible for any bugs introduced with version 2.00.  
  81.   Ken has not worked on this program in some time, but I will keep him 
  82.   current.  I expect he will remain the clearinghouse for the various 
  83.   modifiers of his program.  You can call me at (207) 866-7903, or write to 
  84.   me at:
  85.  
  86.     Jeffrey Hayes, 130 Forest Ave., Lot 1, Orono, Maine 04473
  87.     Internet: tvdog@delphi.com
  88.     Delphi: tvdog
  89.     Other systems: Use whatever method your system provides for sending 
  90.       Internet email.
  91.  
  92.   ... or you could just write to Ken and "rat me out." (!)
  93.  
  94.              -- J.L. Hayes, June 22, 1994 - never mind how old *I* am!]
  95.  
  96. THIS IS THE STRUCTURE AS I RECEIVED IT.  AS I KNOW -NOTHING- ABOUT C, THIS
  97. IS GOING TO BE A *BIT* OF A CHALLENGE, BUT, SINCE I DON'T KNOW MUCH ABOUT
  98. PASCAL EITHER, LIFE SHOULD BE A LITTLE SIMPLER!
  99.  
  100. struct dmheader {                  /* Structure of the header block      */
  101.        INT marker;                 /* Marker bytes - should be 00 1a     */
  102.        CHAR note_count;            /* Number of notes in instrument file */
  103.        CHAR inst_num;              /* Instrument number                  */
  104.        CHAR inst_name[10];         /* Instrument name                    */
  105.        INT sample_rate;            /* Sampling rate                      */
  106.        CHAR filler[16];            /* I don't know what this does        */
  107.        unsigned long sample_size;  /* Number of samples in file          */
  108.        CHAR filler2[8];            /* More unknown space                 */
  109.  
  110.   [Note:  I've been able to puzzle out most of the unknown parts of the 
  111.   .snd header.  See CONV2SND.DOC. - J.L. Hayes]
  112.  
  113. *)
  114.  
  115.  
  116. {pseudo-program - 'cause it seems to help program development!
  117. [Pseudocode updated. - JLH]
  118.  
  119.     define deskmate sound header.
  120.     start program.
  121.     print_banner;   (* glory lines *)
  122.  
  123.     IF 0 or >2 command_line_parameters THEN message1
  124.     ELSE IF 2 command_line_parameters THEN
  125.        dm_soundfile := second_parameter
  126.        IF dm_soundfile has no extension THEN append .snd
  127.     ELSE
  128.        dm_soundfile := first_parameter with .snd extension
  129.     IF 1 or 2 command_line_parameters THEN BEGIN
  130.        search for file given as first_parameter
  131.        IF file doesn't exist THEN message2
  132.        input_file := first_parameter
  133.        try to open dm_soundfile for writing
  134.        IF output file invalid THEN message3
  135.        open input_file for reading
  136.        IF .wav file THEN
  137.           read sample_rate from .wav header
  138.           read sample_size from .wav header
  139.           read start_offset from .wav header
  140.        ELSE
  141.           ask user for sample_rate
  142.        ask user for sound_name
  143.        IF NOT .wav file THEN
  144.           sample_size := file length
  145.           start_offset := 0
  146.  
  147.        add header to beginning of dm_soundfile
  148.        seek to start_offset in input_file
  149.        add sample_size bytes from input_file to dm_soundfile
  150.        close input_file
  151.        close dm_soundfile
  152.  
  153.        report success or failure in operation;
  154.        say our goodbyes;
  155.        print_end_banner;
  156.  
  157.     print_banner:
  158.     WRITELN('xxx program by Kenneth Udut');
  159.  
  160.     message1:
  161.     WRITELN('You must specify xxx arguments');
  162.     print_end_banner;
  163.  
  164.     message2:
  165.     WRITELN('file xxx doesn't exist');
  166.     print_end_banner;
  167.  
  168.     message3:
  169.     WRITELN('file xxx can't be created');
  170.     print_end_banner;
  171.  
  172.     print_end_banner:
  173.     WRITELN('write the author xxxxxx');
  174.     halt;
  175.     END.
  176.  
  177. }
  178.  
  179.  
  180.  
  181.         (* THE REAL PROGRAM NOW FOLKS!!! HOLD ON TO YOUR HATS! *)
  182.  
  183.  
  184. (***********************************************************************)
  185. (***********************************************************************)
  186.  
  187.  
  188. PROGRAM DM_Sound_Cnv;
  189.  
  190. CONST
  191.     z = CHR(0);                     {saves typing, 24-JAN-1993}
  192.  
  193. TYPE STRING3 = STRING[3];     {for file extensions}
  194.  
  195. VAR is_wav      : Boolean;    {True if .wav header found}
  196.     start_offset: longint;    {offset in input file of start of sound data}
  197.     sample_size : longint;    {number of samples}
  198.     sample_rate : BYTE;       {merely carries indication of which rate it is}
  199.     sound_name  : string[9];  {Name that appears in DeskMate SOUND.PDM}
  200.     human_name  : string;     {for silliness.}
  201.     dm_soundfile: string;     {output sound file}
  202.  
  203. (***********************************************************************)
  204.  
  205. PROCEDURE start_banner;
  206. BEGIN (* start_banner *)
  207.     WRITELN('CONV2SND - Version 2.00, by Kenneth Udut,',
  208.         ' - Public Domain');
  209.     WRITELN('(Modified by J.L. Hayes, 6/22/1994)' );
  210.     WRITELN('           Converts "other" digitized sound ',
  211.         'formats to DeskMate .SND format');
  212.     WRITELN('           for use with the DeskMate SOUND.PDM ',
  213.         'program for editing purposes!');
  214.     WRITELN;
  215.     WRITELN('           Syntax: CONV2SND ROCKY.VOC, ',
  216.         'where ROCKY.VOC is *any* digitized sound');
  217.     WRITELN('_______________________________________',
  218.         '________________________________________');
  219. END; (* start_banner *)
  220.  
  221. (***********************************************************************)
  222.  
  223. PROCEDURE end_banner;
  224. BEGIN (* end_banner *)
  225.     WRITELN('____________________________________',
  226.         '___________________________________________');
  227.     WRITELN('Catch ya later, my friend!  Drop me a note, ',
  228.         human_name,' - I promise I''ll reply!');
  229.     WRITELN;
  230.     WRITELN('Kenneth Udut, 170 East Clay Avenue, ',
  231.         'Roselle Park, NJ 07204-2050');
  232.     WRITE('kudut@ritz.mordor.com     908/241-6246     February 3, 1993');
  233.     halt;
  234. END; (* end_banner *)
  235.  
  236. (***********************************************************************)
  237.  
  238. FUNCTION lastpos(st: STRING; ch: char): integer;
  239.     { Returns the position of the last occurrence of ch in st, 0 if not 
  240.       present. }
  241.  
  242. VAR i: integer;
  243.     place: integer;
  244.  
  245. BEGIN (* lastpos *)
  246.     i := length(st);
  247.     place := 0;
  248.     WHILE (i > 0) AND (place = 0) DO BEGIN
  249.         IF st[i] = ch THEN
  250.             place := i;
  251.         i := i - 1;
  252.     END; (* while *)
  253.     lastpos := place;
  254. END; (* lastpos *)
  255.  
  256. (***********************************************************************)
  257.  
  258. FUNCTION has_extension(st: STRING): Boolean;
  259.     { Returns True if filename st has an extension. }
  260.  
  261. VAR dotplace: integer;         (* last position of '.' in st *)
  262.     slashplace: integer;       (* last position of '\' in st *)
  263.     colonplace: integer;       (* last position of ':' in st *)
  264.  
  265. BEGIN (* has_extension *)
  266.     slashplace := lastpos(st, '\');
  267.     colonplace := lastpos(st, ':');
  268.     IF colonplace > slashplace THEN
  269.         slashplace := colonplace;
  270.     IF slashplace <> 0 THEN
  271.         delete(st, 1, slashplace);
  272.     dotplace := lastpos(st, '.');
  273.     IF dotplace = 0 THEN
  274.         has_extension := False
  275.     ELSE
  276.         has_extension := (dotplace >= length(st)-3);
  277. END; (* has_extension *)
  278.  
  279. (***********************************************************************)
  280.  
  281. FUNCTION set_extension(st: STRING; ext: STRING3): STRING;
  282.     { Sets the extension of filename st to ext and returns the result. }
  283.  
  284. VAR dotplace: integer;         (* last position of '.' in st *)
  285.     slashplace: integer;       (* last position of '\' in st *)
  286.     colonplace: integer;       (* last position of ':' in st *)
  287.     pathname: STRING;          (* drive and path, excluding filename *)
  288.     filename: STRING;          (* filename, excluding drive and path *)
  289.  
  290. BEGIN (* set_extension *)
  291.     slashplace := lastpos(st, '\');
  292.     colonplace := lastpos(st, ':');
  293.     IF colonplace > slashplace THEN
  294.         slashplace := colonplace;
  295.     IF slashplace = 0 THEN
  296.         pathname := ''
  297.     ELSE BEGIN
  298.         pathname := copy(st, 1, slashplace);
  299.         delete(st, 1, slashplace);
  300.     END;
  301.     filename := st;
  302.     dotplace := lastpos(filename, '.');
  303.     IF dotplace = 0 THEN
  304.         filename := filename + '.' + ext
  305.     ELSE
  306.         filename := copy(filename, 1, dotplace) + ext;
  307.     set_extension := pathname + filename;
  308. END; (* set_extension *)
  309.  
  310. (***********************************************************************)
  311.  
  312. PROCEDURE check_command_line;
  313.     (* This procedure has been modified in version 2.00 to allow the 
  314.        user to specify the output file, and to make the output file
  315.        name default to the input file name, plus an .snd extension. *)
  316.  
  317. VAR dotpos : integer;  (* position of "." in input filename *)
  318.  
  319. BEGIN (* check_command_line *)
  320.     IF (ParamCount = 0) or (ParamCount > 2) THEN BEGIN
  321.         WRITELN('You have specified either NO filenames, TOO MANY filenames, ',
  322.             'or tried switches.');
  323.         WRITELN('This program only asks for one or two filenames, so all you ',
  324.             'need to do is the');
  325.         WRITELN('following.  If the sound file you wish to convert is called ',
  326.             'BULLWINK, simply');
  327.         WRITELN('type one of these:');
  328.         WRITELN;
  329.         WRITELN('   CONV2SND BULLWINK      [or]        CONV2SND BULLWINK ',
  330.             'FOO');
  331.         WRITELN;
  332.         WRITELN('The sound in BULLWINK will be converted to DeskMate .SND ',
  333.             'form.  In the first');
  334.         WRITELN('case, the new file will be named BULLWINK.SND; in the ',
  335.             'second case, the file');
  336.         WRITELN('will be named FOO.SND.  (See Conv2snd.doc for details.)' );
  337.         WRITELN;
  338.         WRITELN('NOTE: You must have free space on your disk for the new file.');
  339.         end_banner
  340.     END; (* if ParamCount = 0 or ParamCount > 2 *)
  341.         (* Number of parameters OK.  Set output filename. *)
  342.     IF (ParamCount = 2) THEN BEGIN (* output file specified on command line *)
  343.         dm_soundfile := ParamStr(2);
  344.         IF NOT has_extension(dm_soundfile) THEN
  345.             dm_soundfile := set_extension(dm_soundfile, 'snd');
  346.     END
  347.     ELSE BEGIN       (* output file not specified, defaults to input + .snd *)
  348.         dm_soundfile := ParamStr(1);  
  349.         dm_soundfile := set_extension(dm_soundfile, 'snd');
  350.     END; (* else if ParamCount <> 2 *)
  351. END; (* check_command_line *)
  352.  
  353. (***********************************************************************)
  354.  
  355. PROCEDURE not_here;
  356. BEGIN (* not_here *)
  357.     WRITELN;
  358.     WRITELN('The input file you specified, "',ParamStr(1),
  359.         '", doesn''t seem to be present.');
  360.     WRITELN('Please check your spelling, maybe do a DIR/W ',
  361.         'a couple of times, fiddle');
  362.     WRITELN('around a wee bit and give it another shot };-> ');
  363.     WRITELN;
  364.     WRITELN('adonis_note: Time is a great teacher, ',
  365.         'but unfortunately kills all its pupils.');
  366.     end_banner;
  367. END; (* not_here *)
  368.  
  369. (***********************************************************************)
  370.  
  371. PROCEDURE bad_output;
  372.     (* This procedure is called when the output file cannot be created. *)
  373. BEGIN (* bad_output *)
  374.     WRITELN;
  375.     WRITELN('The output file you specified, "',dm_soundfile,'", could not');
  376.     WRITELN('be created.  Enter a valid filename for the output file, ',
  377.         'or leave blank');
  378.     WRITELN('to use the default.');
  379.     end_banner;
  380. END; (* bad_output *)
  381.  
  382. (***********************************************************************)
  383.  
  384. PROCEDURE full_disk;
  385.     (* This procedure is called when a full disk is detected when writing
  386.        to the output file. *)
  387. BEGIN (* full_disk *)
  388.     WRITELN;
  389.     WRITELN('The disk where the output file goes is full!  File "',
  390.         dm_soundfile,'"');
  391.     WRITELN('has been erased.  Try again, specifying a file on a drive ',
  392.         'with more space');
  393.     WRITELN('as the output file.');
  394.     end_banner;
  395. END; (* full_disk *)
  396.  
  397. (***********************************************************************)
  398.  
  399. (****************** WISH ME LUCK *********************)
  400. (*                                                   *)
  401. (* This is the portion where I attempt to convert a  *)
  402. (* regular sound file into an extra-special DESKMATE *)
  403. (* SND FILE!  It's the last part of the program for  *)
  404. (* me to write, as I was having too much fun procras *)
  405. (* tinating, making up the text and such!            *)
  406. (*                                                   *)
  407. (*****************************************************)
  408. PROCEDURE convert_file;
  409.  
  410. VAR
  411.     old_snd_file : FILE;
  412.     new_snd_file : FILE;
  413.     header       : array [0..43] of byte;
  414.     wordrate     : ^word;
  415.     sampsize     : ^longint;
  416.     i            : INTEGER;
  417.     bytesdone    : longint;     {number of bytes copied to output file}
  418.     thistime     : longint;     {number of bytes done in 1 pass of copy loop}
  419.  
  420.     NumRead, NumWritten: Word;    {for BLOCKREAD and BLOCKWRITE}
  421.     buf: array[1..2048] of Char;
  422.  
  423. BEGIN (* convert_file *)
  424.         (* Prepare input file for reading and determine number of samples. *)
  425.     ASSIGN(old_snd_file, ParamStr(1));
  426.     RESET(old_snd_file, 1);
  427.         (* The following two lines were added in v. 2.00 to provide for 
  428.            .wav files. - JLH *)
  429.     SEEK(old_snd_file, start_offset);
  430.     IF NOT is_wav THEN  (* added in v. 2.00 *)
  431.         sample_size := FileSize(old_snd_file);
  432.     WRITELN;
  433.     WRITELN('Hey, ',human_name,'?  ',paramstr(1), ' contains ',
  434.         sample_size,' samples.');
  435.     WRITELN;
  436.  
  437.         (* Construct .snd header.  Ken tried to do it this way but couldn't 
  438.            get it to work.  This code is new in v. 2.00. *)
  439.     FOR i := 0 to 43 DO
  440.         header[i] := 0;
  441.     header[0] := $1A;
  442.     header[2] := 1;
  443.     FOR i := 1 to length(sound_name) DO
  444.         header[i+3] := byte(sound_name[i]);
  445.     wordrate := @header[$0E];
  446.     wordrate^ := 5500 SHL (sample_rate-1);
  447.     header[$10] := $FF;
  448.     header[$12] := $FF;
  449.     header[$13] := $FF;
  450.     header[$14] := $2C;          (* add initial offset field, new for v.2 *)
  451.     sampsize := @header[$20];
  452.     sampsize^ := sample_size;
  453.  
  454.         (* Create output file and write header. *)
  455.     ASSIGN(new_snd_file, dm_soundfile);
  456.     REWRITE(new_snd_file, 1);
  457.     BLOCKWRITE(new_snd_file, header, 44);
  458.  
  459.         (* Announce success (optimistic, aren't we?). *)
  460.     WRITELN('All Important 44 byte header portion successfully written to ',
  461.         dm_soundfile,'!');
  462.     WRITELN;
  463.     WRITELN('Now adding old digitized sound file to new, ',
  464.         'DeskMate format sound file.');
  465.     WRITELN('Each ">" equals 2048 sound bytes.');
  466.  
  467.         (* The loop below has been changed from an EOF loop in v. 1.98 to a 
  468.            loop that copies sample_size bytes.  The length of the data 
  469.            block from the .wav header, if present, will be used by v. 2.00 
  470.            to set sample_size.  This enables skipping over junk at the end 
  471.            of a .wav file, such as is attached by Goldwave.  EOF, 
  472.            specifically premature EOF, still needs to be detected, though, 
  473.            to avoid an infinite loop. - JLH *)
  474.     bytesdone := 0;            (* number of bytes copied so far *)
  475.     thistime := 0;             (* number of bytes to copy this pass *)
  476.     NumRead := 0;              (* used to detect premature EOF *)
  477.     WHILE (bytesdone < sample_size) AND (NumRead = thistime) DO BEGIN
  478.         thistime := sample_size - bytesdone;
  479.         IF thistime > SizeOf(buf) THEN
  480.             thistime := SizeOf(buf);
  481.         BLOCKREAD(old_snd_file,buf,
  482.             word(thistime),NumRead);
  483.         BLOCKWRITE(new_snd_file,buf,NumRead,NumWritten);
  484.             (* Lines below to detect a full disk added in version 2.00 *)
  485.         IF (NumWritten <> NumRead) THEN BEGIN
  486.             WRITELN;
  487.             CLOSE(old_snd_file);    (* close both files *)
  488.             CLOSE(new_snd_file);
  489.             ERASE(new_snd_file);    (* erase the incomplete output file *)
  490.                 (* display error message to the user and halt the program *)
  491.             full_disk;
  492.         END; (* if NumWritten <> NumRead *)
  493.         bytesdone := bytesdone + NumWritten;
  494.         WRITE('>');
  495.     END; (* while bytesdone < sample_size *)
  496.  
  497.         (* If premature EOF occurred while copying, go back and change the
  498.            header on the output file to match the actual number of samples 
  499.            read from the input file. - JLH *)
  500.     IF bytesdone < sample_size THEN BEGIN
  501.         WRITELN;
  502.         WRITELN('The length of the input .wav file does not match ',
  503.             'its .wav header.  Its true');
  504.         WRITELN('length is ', bytesdone, '.' );
  505.         WRITELN;
  506.         WRITELN('Adjusting the .snd header of the output file ',
  507.             'to compensate ...');
  508.         SEEK(new_snd_file, 32);
  509.         BLOCKWRITE(new_snd_file, bytesdone, 4);
  510.         SEEK(new_snd_file, filesize(new_snd_file));
  511.     END; (* if bytesdone < sample_size *)
  512.  
  513.         (* close both files *)
  514.     WRITELN;
  515.     CLOSE(old_snd_file);
  516.     CLOSE(new_snd_file);
  517.     WRITELN;
  518.     WRITELN('Safely closing ',ParamStr(1), ' and ',dm_soundfile,'.');
  519. END; (* convert_file *)
  520.  
  521. (***********************************************************************)
  522.  
  523. PROCEDURE ask_questions;      {02-FEB-93 - for sample rate}
  524.  
  525. VAR inchar  : char;   {for reading sampling rate, avoids "Runtime error 106"}
  526.  
  527. BEGIN (* ask_questions *)
  528.     sound_name := '';
  529.     human_name := '';
  530.     WRITELN;
  531.     WRITELN('______Q_U_E_S_T_I_O_N_S______');
  532.     WRITELN('                                       ',
  533.         '_________________________________ ');
  534.     IF NOT is_wav THEN BEGIN
  535.         WRITELN('A) Select Sampling Rate.              ',
  536.             '/ Sample Rate is an indication of \');
  537.         WRITELN('                                      ',
  538.             '\ the rate at which SOUND.PDM  or /');
  539.         WRITELN('   1) 5500  -  ''speech''               ',
  540.             '/ or other  DeskMate .SND players \');
  541.         WRITELN('   2) 11000 -  ''usual recordings''     ',
  542.             '\ reads and plays back  the sound /');
  543.         WRITELN('   3) 22000 -  ''hi-quality / Mac''      ',
  544.             '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ');
  545.         WRITELN;
  546.         WRITE(CHR(7));
  547.         sample_rate := 0;
  548.         WHILE (sample_rate < 1) OR (sample_rate > 3) DO
  549.             BEGIN
  550.                 WRITE('Please Select 1, 2, or 3. > ');
  551.                 READLN(inchar);
  552.                 sample_rate := ord(inchar) - ord('0');
  553.             END; (* while *)
  554.         WRITELN;
  555.         WRITELN;
  556.         WRITELN('                                       ',
  557.             '_________________________________ ');
  558.     END; (* if not is_wav *)
  559.     WRITELN('B) Select Name of Sound               ',
  560.         '/ "Name of Sound" *isn''t* the name\');
  561.     WRITELN('   9 Characters or Less               ',
  562.         '\  of the file being created.  It /');
  563.     WRITELN('                                      ',
  564.         '/  It is the  name  that  appears \');
  565.     WRITELN('   Example: Disgusting  or            ',
  566.         '\  in SOUND.PDM next to "Name:"   /');
  567.     WRITELN('            Eastwood                   ',
  568.         '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ');
  569.     WRITE(CHR(7));
  570.         (* Note:  version 1.98 required the user to enter a sound name.  In
  571.            this version, a null name will be used if none is entered. - JLH *)
  572.     WRITE('Name / Description of Sound (9 Characters or Less) > ');
  573.     READLN(sound_name);
  574.  
  575.     (* It is no longer necessary to pad the string out to its full length, 
  576.        as was done in earlier versions. - JLH *)
  577.  
  578.     WRITELN;
  579.     WRITELN;
  580.     WRITELN('C) Oh, and by the way ...');
  581.     WRITELN('   My name is Ken.  What''s your name?');
  582.     WRITELN;
  583.     WRITE(CHR(7));
  584.         (* Note:  version 1.98 required the user to enter his or her name.  In
  585.            this version, a default name of "CONV2SND user" will be used if none
  586.            is entered. - JLH *)
  587.     WRITE('Your Name? > ');
  588.     READLN(human_name);
  589.     IF (human_name = '') THEN
  590.         human_name := 'CONV2SND user';
  591.     WRITELN;
  592.     WRITELN('Thanks for answering my questions!  Now, ',human_name,
  593.         ', here goes CONV2SND!!!');
  594.     WRITELN;
  595. END; (* ask_questions *)
  596.  
  597. (***********************************************************************)
  598.  
  599. FUNCTION FileExists(FileName: STRING): Boolean;
  600.     { Returns True IF file exists; otherwise,
  601.       it returns False. }
  602.  
  603. VAR f : file;
  604.  
  605. BEGIN (* FileExists *)
  606.     {$I-}
  607.     ASSIGN(f, FileName);
  608.     RESET(f);
  609.     CLOSE(f);
  610.     {$I+}
  611.     FileExists := (IOResult = 0) and (FileName <> '');
  612. END; (* FileExists *)
  613.  
  614. (***********************************************************************)
  615.  
  616. FUNCTION CanCreate(FileName: STRING): Boolean;
  617.     { This function does for the output file what FileExists does for 
  618.       the input file.  Returns True if the file can be created, False 
  619.       otherwise. }
  620.  
  621. VAR f     : file;
  622.     result: Boolean;
  623.  
  624. BEGIN (* CanCreate *)
  625.     {$I-}
  626.     ASSIGN(f, FileName);
  627.     REWRITE(f);
  628.     result := (IOResult = 0);
  629.     {$I+}
  630.     IF result THEN BEGIN
  631.         CLOSE(f);
  632.         ERASE(f);
  633.     END; (* if result *)
  634.     CanCreate := result;
  635. END; (* CanCreate *)
  636.  
  637. (***********************************************************************)
  638.  
  639. PROCEDURE check_wav;
  640.     (* This procedure checks for a valid RIFF WAVE header on the input file 
  641.        and sets the start of sound data, the length of the sound data, and 
  642.        the sampling rate according to the header, if present.  It also 
  643.        displays an appropriate message to the user if the .wav is of a type 
  644.        that can't be converted directly by CONV2SND. *)
  645.  
  646.     (* Labels to jump to in case of errors.  Yeah, yeah, I *know* about 
  647.        "Never use GOTO!", but I wouldn't want to see what this routine 
  648.        would look like without it. *)
  649. LABEL 100, 200, 300, 400;
  650.  
  651. VAR
  652.         (* Input file, untyped so we can treat it as a bytestream, like in 
  653.            C. *)
  654.     f           : FILE;
  655.         (* Label for chunks in the .wav file. *)
  656.     chunklabel  : packed array [0..3] of char;
  657.         (* Number of bytes successfully read by BLOCKREAD. *)
  658.     bytesread   : word;
  659.         (* Target of seek operation on the input file. *)
  660.     seekpoint   : longint;
  661.         (* Size of the input file in bytes, to make sure we don't try to 
  662.            seek past the end of it. *)
  663.     fsize       : longint;
  664.         (* do_format sets this to True if there is an error in the format 
  665.            chunk, but the user opts to ignore the header and continue 
  666.            anyway. *)
  667.     fmt_error   : Boolean;
  668.         (* This is set to true when a format chunk has been found.  We have 
  669.            to make sure that there is a format chunk in the file before the 
  670.            data chunk. *)
  671.     fmt_found   : Boolean;
  672.         (* When the user is asked a "yes" or "no" question, getyn puts the 
  673.            answer here. *)
  674.     answer      : char;
  675.         (* The size of a chunk, as read from the file.  The size of the 
  676.            data chunk is the number of samples in the file, provided they 
  677.            are mono 8-bit. *)
  678.     blocksize   : longint;
  679.  
  680.     (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  681.  
  682.     PROCEDURE getyn;
  683.         (* This procedure gets a "yes" or "no" answer from the user. *)
  684.  
  685.     BEGIN (* getyn *)
  686.         REPEAT
  687.             answer := 'q';
  688.             WRITE('Enter Y or N. > ');
  689.             READLN(answer);
  690.             answer := UpCase(answer);
  691.         UNTIL (answer = 'Y') or (answer = 'N');
  692.     END; (* getyn *)
  693.  
  694.     (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  695.  
  696.     PROCEDURE do_format( VAR fmt_error: Boolean );
  697.         (* This procedure reads the format chunk from the .wav file,
  698.            verifies that the .wav is of a type that can be converted, and 
  699.            sets the sampling rate.  If an invalid format is detected, the 
  700.            user is asked if he wants to continue.  If not, the program is 
  701.            terminated.  If so, fmt_error is set to True and the procedure 
  702.            returns.  If the format is valid but of an unsupported type, 
  703.            do_format provides instructions on how to fix the file and exits the 
  704.            program. *)
  705.  
  706.     VAR  (* 16-byte Microsoft PCM format chunk *)
  707.         fmtchunk: RECORD
  708.                 tag         : word;         (* format tag, must be 1 *)
  709.                 nchannels   : word;         (* number of channels, 1 = mono *)
  710.                 rate        : longint;      (* sampling rate in Hz *)
  711.                 bytespersec : longint;      (* not used *)
  712.                 bytespersamp: word;         (* not used *)
  713.                 size        : word;         (* sample size in bits *)
  714.             END; (* record *)
  715.  
  716.     BEGIN (* do_format *)
  717.             (* Start out optimistic. *)
  718.         fmt_error := False;
  719.  
  720.             (* If the format chunk is not 16 bytes long, it's not Microsoft 
  721.                PCM, or it's not a valid format. *)
  722.         IF blocksize <> 16 THEN BEGIN
  723.             WRITELN('The .wav format type is unknown or invalid.  ',
  724.                 'Do you want to ignore the header');
  725.             WRITELN('and go on?');
  726.             getyn;
  727.             IF answer = 'N' THEN BEGIN
  728.                 CLOSE(f);
  729.                 end_banner;
  730.             END;
  731.             fmt_error := True;
  732.             exit;
  733.         END; (* if blocksize <> 16 *)
  734.  
  735.             (* Read in the format chunk. *)
  736.         BLOCKREAD(f, fmtchunk, 16, bytesread);
  737.         IF bytesread < 16 THEN BEGIN
  738.             WRITELN('End of file encountered while reading .wav header.  ',
  739.                 'The file is probably');
  740.             WRITELN('corrupt.  Do you want to ignore the header and go on?');
  741.             getyn;
  742.             IF answer = 'N' THEN BEGIN
  743.                 CLOSE(f);
  744.                 end_banner;
  745.             END;
  746.             fmt_error := True;
  747.             exit;
  748.         END; (* if bytesread < 16 *)
  749.  
  750.             (* Verify the format tag. *)
  751.         IF fmtchunk.tag <> 1 THEN BEGIN
  752.             WRITELN('The .wav format type is unknown or invalid.  ',
  753.                 'Do you want to ignore the header');
  754.             WRITELN('and go on?');
  755.             getyn;
  756.             IF answer = 'N' THEN BEGIN
  757.                 CLOSE(f);
  758.                 end_banner;
  759.             END;
  760.             fmt_error := True;
  761.             exit;
  762.         END; (* if fmtchunk.tag <> 1 *)
  763.  
  764.             (* Verify the number of channels. *)
  765.         IF fmtchunk.nchannels <> 1 THEN BEGIN
  766.             WRITELN(ParamStr(1),' has ',fmtchunk.nchannels,' channels.');
  767.             WRITELN('CONV2SND can only convert mono .wav''s directly.  You ',
  768.                 'can use Ppwav to mix the');
  769.             WRITELN('.wav to mono so that CONV2SND can convert it to .snd.');
  770.             CLOSE(f);
  771.             end_banner;
  772.         END; (* if more than 1 channel *)
  773.  
  774.             (* Convert the sampling rate to the byte code needed by 
  775.                convert_file. *)
  776.         IF (fmtchunk.rate >= 0.95*5500) and (fmtchunk.rate <= 1.05*5500) THEN
  777.             sample_rate := 1
  778.         ELSE IF (fmtchunk.rate >= 0.95*11000) and (fmtchunk.rate <= 1.05*11000)
  779.             THEN sample_rate := 2
  780.         ELSE IF (fmtchunk.rate >= 0.95*22000) and (fmtchunk.rate <= 1.05*22000)
  781.             THEN sample_rate := 3
  782.         ELSE IF (fmtchunk.rate >= 0.95*44000) and (fmtchunk.rate <= 1.05*44000)
  783.             THEN BEGIN
  784.             WRITELN(ParamStr(1),' has a sampling rate of ',fmtchunk.rate,'.');
  785.             WRITELN('Use Ppwav to cut its rate in half and try again.');
  786.             CLOSE(f);
  787.             end_banner;
  788.             END (* rate near 44kHz *)
  789.         ELSE BEGIN
  790.             WRITELN(ParamStr(1),' has a sampling rate of ',fmtchunk.rate,'.');
  791.             WRITELN('You will have to use Sox or a similar program to ',
  792.                 'resample the sound before');
  793.             WRITELN('converting it to .snd.  Sound.pdm only supports 5500, ',
  794.                 '11000, and 22000 as');
  795.             WRITELN('sampling rates.  You should resample the sound to one ',
  796.                 'of those.');
  797.             CLOSE(f);
  798.             end_banner;
  799.         END; (* sample rate not supported *)
  800.  
  801.             (* Verify 8-bit samples. *)
  802.         IF fmtchunk.size > 8 THEN BEGIN
  803.             WRITELN(ParamStr(1),' has ',fmtchunk.size,'-bit samples.');
  804.             WRITELN('The Tandy sound chip uses 8-bit samples.  Use Ppwav to ',
  805.                 'convert the file to');
  806.             WRITELN('8-bit samples and try again.');
  807.             CLOSE(f);
  808.             end_banner;
  809.         END; (* samples not 8-bit *)
  810.     END; (* do_format *)
  811.  
  812.     (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  813.  
  814. BEGIN (* check_wav *)
  815.         (* Initially, assume it's not a .wav. *)
  816.     is_wav := False;
  817.     start_offset := 0;
  818.  
  819.         (* Open the input file as an "untyped" file and get file size. *)
  820.     ASSIGN(f, ParamStr(1));
  821.     RESET(f, 1);
  822.     fsize := FileSize(f);
  823.  
  824.         (* Read in "RIFF" header, if present. *)
  825.     BLOCKREAD(f, chunklabel, 4, bytesread);
  826.     IF (bytesread < 4) or (chunklabel <> 'RIFF') THEN goto 100;
  827.  
  828.         (* Read in "WAVE" header, if present. *)
  829.     seekpoint := FilePos(f) + 4;
  830.     IF seekpoint >= fsize THEN goto 100;
  831.     SEEK(f, seekpoint);
  832.     BLOCKREAD(f, chunklabel, 4, bytesread);
  833.     IF (bytesread < 4) or (chunklabel <> 'WAVE') THEN goto 100;
  834.  
  835.         (* Announce header found. *)
  836.     WRITELN('RIFF WAVE header found.  Checking format ...');
  837.  
  838.         (* Loop over chunks until data chunk found or end of file. *)
  839.     fmt_found := False;
  840.     REPEAT
  841.             (* Read the chunk label and length. *)
  842.         BLOCKREAD(f, chunklabel, 4, bytesread);
  843.         IF bytesread < 4 THEN goto 200;
  844.         BLOCKREAD(f, blocksize, 4, bytesread);
  845.         IF bytesread < 4 THEN goto 200;
  846.             (* If this is a format chunk, make sure we haven't already seen 
  847.                one before, take note of the fact that we've seen one *now*, 
  848.                and call do_format to check out the format. *)
  849.         IF chunklabel = 'fmt ' THEN BEGIN
  850.             IF fmt_found THEN goto 300;
  851.             fmt_found := True;
  852.             do_format(fmt_error);
  853.             IF fmt_error THEN goto 100;
  854.         END (* if chunklabel = 'fmt ' *)
  855.             (* If this is neither a format chunk nor a data chunk, skip it. *)
  856.         ELSE IF chunklabel <> 'data' THEN BEGIN
  857.             seekpoint := FilePos(f) + blocksize;
  858.             IF seekpoint > fsize THEN goto 200;
  859.             SEEK(f, seekpoint);
  860.         END; (* else if chunklabel <> 'data' *)
  861.     UNTIL chunklabel = 'data';
  862.  
  863.         (* Data chunk found.  Make sure that we saw a format chunk first. *)
  864.     IF NOT fmt_found THEN goto 400;
  865.  
  866.         (* Everything is fine.  do_format has set sample_rate.  Set is_wav 
  867.            to True, record the point in the input file where the sound data 
  868.            begins, and note the number of samples. *)
  869.     is_wav := True;
  870.     start_offset := FilePos(f);
  871.     sample_size := blocksize;
  872.  
  873.         (* Tell the user we succeeded, close the file, and exit. *)
  874.     WRITELN('Format OK!');
  875.     CLOSE(f);
  876.     exit;
  877.  
  878.     (* Jump to here if .wav header not present, or if do_format indicated 
  879.        that the format is erroneous. *)
  880. 100:
  881.     CLOSE(f);
  882.     exit;
  883.  
  884.     (* Jump to here on EOF while reading .wav header. *)
  885. 200:
  886.     CLOSE(f);
  887.     WRITELN('End of file encountered while reading .wav header.  ',
  888.         'The file is probably');
  889.     WRITELN('corrupt.  Do you want to ignore the header and go on?');
  890.     getyn;
  891.     IF answer = 'N' THEN
  892.         end_banner;
  893.     exit;
  894.  
  895.     (* Jump to here if more than one format chunk. *)
  896. 300:
  897.     CLOSE(f);
  898.     WRITELN('There is more than one format chunk in the .wav header.  ',
  899.         'The file is probably');
  900.     WRITELN('corrupt.  Do you want to ignore the header and go on?');
  901.     getyn;
  902.     IF answer = 'N' THEN
  903.         end_banner;
  904.     exit;
  905.  
  906.     (* Jump to here if no format chunk. *)
  907. 400:
  908.     CLOSE(f);
  909.     WRITELN('There is no format chunk in the .wav header.  The file is ',
  910.         'probably corrupt.');
  911.     WRITELN('Do you want to ignore the header and go on?');
  912.     getyn;
  913.     IF answer = 'N' THEN
  914.         end_banner;
  915.     exit;
  916. END; (* check_wav *)
  917.  
  918. (***********************************************************************)
  919.  
  920. BEGIN (* Conv2snd *)
  921.     start_banner;
  922.  
  923.        {the user is assigned a name here, in case something happens early on}
  924.     human_name := 'CONV2SND user';
  925.  
  926.        {if a problem occurs, it's taken care of in this procedure:}
  927.     check_command_line;
  928.     IF not FileExists(paramstr(1)) THEN not_here;
  929.     IF not CanCreate(dm_soundfile) THEN bad_output;
  930.  
  931.     check_wav;
  932.     ask_questions;
  933.     convert_file;
  934.  
  935.     WRITELN(paramstr(1),' has been successfully converted into a ',
  936.         'DeskMate Sound file');
  937.     WRITELN('100% editable by DeskMate''s Sound Editor!!!  Congratulations, ',
  938.         human_name,'!!!');
  939.     WRITELN;
  940.     WRITELN('adonis_note: Life is a funny game ... ',
  941.         'some people play ... some people main');
  942.     WRITELN('             (beginning of a famous poem, ',
  943.         'spoken to me by my Tandy 1000 TL');
  944.     WRITELN;
  945.     end_banner;
  946. END. (* Conv2snd *)
  947.